home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / libguile / fports.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-17  |  7.0 KB  |  365 lines
  1. /*    Copyright (C) 1995 Free Software Foundation, Inc.
  2.  * 
  3.  * This program is free software; you can redistribute it and/or modify
  4.  * it under the terms of the GNU General Public License as published by
  5.  * the Free Software Foundation; either version 2, or (at your option)
  6.  * any later version.
  7.  * 
  8.  * This program is distributed in the hope that it will be useful,
  9.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  * GNU General Public License for more details.
  12.  * 
  13.  * You should have received a copy of the GNU General Public License
  14.  * along with this software; see the file COPYING.  If not, write to
  15.  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  *
  17.  * As a special exception, the Free Software Foundation gives permission
  18.  * for additional uses of the text contained in its release of GUILE.
  19.  *
  20.  * The exception is that, if you link the GUILE library with other files
  21.  * to produce an executable, this does not by itself cause the
  22.  * resulting executable to be covered by the GNU General Public License.
  23.  * Your use of that executable is in no way restricted on account of
  24.  * linking the GUILE library code into it.
  25.  *
  26.  * This exception does not however invalidate any other reasons why
  27.  * the executable file might be covered by the GNU General Public License.
  28.  *
  29.  * This exception applies only to the code released by the
  30.  * Free Software Foundation under the name GUILE.  If you copy
  31.  * code from other Free Software Foundation releases into a copy of
  32.  * GUILE, as the General Public License permits, the exception does
  33.  * not apply to the code that you add in this way.  To avoid misleading
  34.  * anyone as to the status of such modified files, you must delete
  35.  * this exception notice from them.
  36.  *
  37.  * If you write modifications of your own for GUILE, it is your choice
  38.  * whether to permit this exception to apply to your modifications.
  39.  * If you do not wish that, delete this exception notice.  
  40.  */
  41.  
  42.  
  43. #include <stdio.h>
  44. #include "_scm.h"
  45. #ifdef HAVE_UNISTD_H
  46. #include <unistd.h>
  47. #else
  48. char *ttyname ();
  49. char *tmpnam ();
  50. sizet fwrite ();
  51. #endif
  52.  
  53. #ifdef __IBMC__
  54. #include <io.h>
  55. #include <direct.h>
  56. #define ttyname(x) "CON:"
  57. #else
  58. #ifndef MSDOS
  59. #ifndef ultrix
  60. #ifndef vms
  61. #ifdef _DCC
  62. #include <ioctl.h>
  63. #define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0)
  64. #else
  65. #ifdef MWC
  66. #include <sys/io.h>
  67. #else
  68. #ifndef THINK_C
  69. #ifndef ARM_ULIB
  70. #include <sys/ioctl.h>
  71. #endif
  72. #endif
  73. #endif
  74. #endif
  75. #endif
  76. #endif
  77. #endif
  78. #endif
  79.  
  80.  
  81. /* {Ports - file ports}
  82.  * 
  83.  */
  84.  
  85. /* should be called with DEFER_INTS active */
  86. #ifdef __STDC__
  87. SCM 
  88. scm_setbuf0 (SCM port)
  89. #else
  90. SCM 
  91. scm_setbuf0 (port)
  92.      SCM port;
  93. #endif
  94. {
  95. #ifndef NOSETBUF
  96. #ifndef MSDOS
  97. #ifdef FIONREAD
  98. #ifndef ultrix
  99.   SYSCALL (setbuf (STREAM (port), 0););
  100. #endif
  101. #endif
  102. #endif
  103. #endif
  104.   return UNSPECIFIED;
  105. }
  106.  
  107. /* Return the flags that characterize a port based on the mode
  108.  * string used to open a file for that port.
  109.  *
  110.  * See PORT FLAGS in scm.h
  111.  */
  112. #ifdef __STDC__
  113. long
  114. scm_mode_bits (char *modes)
  115. #else
  116. long
  117. scm_mode_bits (modes)
  118.      char *modes;
  119. #endif
  120. {
  121.   return (OPN
  122.       | (strchr (modes, 'r') || strchr (modes, '+') ? RDNG : 0)
  123.       | (   strchr (modes, 'w')
  124.          || strchr (modes, 'a')
  125.          || strchr (modes, '+') ? WRTNG : 0)
  126.       | (strchr (modes, '0') ? BUF0 : 0));
  127. }
  128.  
  129.  
  130. /* scm_open_file
  131.  * Return a new port open on a given file.
  132.  *
  133.  * The mode string must match the pattern: [rwa+]** which
  134.  * is interpreted in the usual unix way.
  135.  *
  136.  * Return the new port.
  137.  */
  138.  
  139. #ifdef __STDC__
  140. SCM
  141. scm_mkfile (char * name, char * modes)
  142. #else
  143. SCM
  144. scm_mkfile (name, modes)
  145.      char * name;
  146.      char * modes;
  147. #endif
  148. {
  149.   register SCM port;
  150.   FILE *f;
  151.   NEWCELL (port);
  152.   DEFER_INTS;
  153.   SYSCALL (f = fopen (name, modes));
  154.   if (!f)
  155.     {
  156.       ALLOW_INTS;
  157.       port = BOOL_F;
  158.     }
  159.   else
  160.     {
  161.       SETSTREAM (port, f);
  162.       if (BUF0 & (CAR (port) = tc16_fport | scm_mode_bits (modes)))
  163.     scm_setbuf0 (port);
  164.       scm_add_to_port_table (port);
  165.       ALLOW_INTS;
  166.     }
  167.   return port;
  168. }
  169.  
  170. PROC (s_open_file, "open-file", 2, 0, 0, scm_open_file);
  171. #ifdef __STDC__
  172. SCM
  173. scm_open_file (SCM filename, SCM modes)
  174. #else
  175. SCM
  176. scm_open_file (filename, modes)
  177.      SCM filename;
  178.      SCM modes;
  179. #endif
  180. {
  181.   SCM port;
  182.   ASSERT (NIMP (filename) && STRINGP (filename), filename, ARG1, s_open_file);
  183.   ASSERT (NIMP (modes) && STRINGP (modes), modes, ARG2, s_open_file);
  184.   port = scm_mkfile (CHARS (filename), CHARS (modes));
  185.   /* Force the compiler to keep filename and modes alive:
  186.    */
  187.   if (port == BOOL_F)
  188.     scm_cons (filename, modes);
  189.   return port;
  190. }
  191.  
  192. /* Return the mode flags from an open port.
  193.  * Some modes such as "append" are only used when opening
  194.  * a file and are not returned here.
  195.  */
  196.  
  197. PROC (s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
  198. #ifdef __STDC__
  199. SCM
  200. scm_port_mode (SCM port)
  201. #else
  202. SCM
  203. scm_port_mode (port)
  204.      SCM port;
  205. #endif
  206. {
  207.   char modes[3] = "";
  208.   ASSERT (NIMP (port) && OPPORTP (port), port, ARG1, s_port_mode);  
  209.   if (CAR (port) & RDNG) {
  210.     if (CAR (port) & WRTNG)
  211.       strcpy (modes, "r+");
  212.     else
  213.       strcpy (modes, "r");
  214.   }
  215.   else if (CAR (port) & WRTNG)
  216.     strcpy (modes, "w");
  217.   if (CAR (port) & BUF0)
  218.     strcat (modes, "0");
  219.   return scm_makfromstr (modes, strlen (modes), 0);
  220. }
  221.  
  222.  
  223. #ifdef __STDC__
  224. static int 
  225. prinfport (SCM exp, SCM port, int writing)
  226. #else
  227. static int 
  228. prinfport (exp, port, writing)
  229.      SCM exp;
  230.      SCM port;
  231.      int writing;
  232. #endif
  233. {
  234.   scm_prinport (exp, port, "port");
  235.   return !0;
  236. }
  237.  
  238.  
  239. #ifdef __STDC__
  240. static int
  241. scm_fgetc (FILE * s)
  242. #else
  243. static int
  244. scm_fgetc (s)
  245.      FILE * s;
  246. #endif
  247. {
  248.   if (feof (s))
  249.     return EOF;
  250.   else
  251.     return fgetc (s);
  252. }
  253.  
  254. #ifdef vms
  255. #ifdef __STDC__
  256. static sizet 
  257. pwrite (char *ptr, sizet size, nitems, FILE *port)
  258. #else
  259. static sizet 
  260. pwrite (ptr, size, nitems, port)
  261.      char *ptr;
  262.      sizet size, nitems;
  263.      FILE *port;
  264. #endif
  265. {
  266.   sizet len = size * nitems;
  267.   sizet i = 0;
  268.   for (; i < len; i++)
  269.     putc (ptr[i], port);
  270.   return len;
  271. }
  272.  
  273. #define ffwrite pwrite
  274. #else
  275. #define ffwrite fwrite
  276. #endif
  277.  
  278.  
  279. /* This otherwise pointless code helps some poor 
  280.  * crippled C compilers cope with life. 
  281.  */
  282. static int
  283. local_fclose (fp)
  284.      FILE * fp;
  285. {
  286.   return fclose (fp);
  287. }
  288.  
  289. static int
  290. local_fflush (fp)
  291.      FILE * fp;
  292. {
  293.   return fflush (fp);
  294. }
  295.  
  296. static int
  297. local_fputc (c, fp)
  298.      int c;
  299.      FILE * fp;
  300. {
  301.   return fputc (c, fp);
  302. }
  303.  
  304. static int
  305. local_fputs (s, fp)
  306.      char * s;
  307.      FILE * fp;
  308. {
  309.   return fputs (s, fp);
  310. }
  311.  
  312. static int
  313. local_ffwrite (ptr, size, nitems, fp)
  314.      void * ptr;
  315.      int size;
  316.      int nitems;
  317.      FILE * fp;
  318. {
  319.   return ffwrite (ptr, size, nitems, fp);
  320. }
  321.  
  322.  
  323. scm_ptobfuns scm_fptob =
  324. {
  325.   scm_mark0,
  326.   local_fclose,
  327.   prinfport,
  328.   0,
  329.   local_fputc,
  330.   local_fputs,
  331.   local_ffwrite,
  332.   local_fflush,
  333.   scm_fgetc,
  334.   local_fclose
  335. };
  336.  
  337. /* {Pipe ports}
  338.  */
  339. scm_ptobfuns scm_pipob =
  340. {
  341.   scm_mark0,
  342.   0,                 /* replaced by pclose in scm_init_ioext() */
  343.   0,                 /* replaced by prinpipe in scm_init_ioext() */
  344.   0,
  345.   local_fputc,
  346.   local_fputs,
  347.   local_ffwrite,
  348.   local_fflush,
  349.   scm_fgetc,
  350.   0
  351. };                /* replaced by pclose in scm_init_ioext() */
  352.  
  353.  
  354. #ifdef __STDC__
  355. void
  356. scm_init_fports (void)
  357. #else
  358. void
  359. scm_init_fports ()
  360. #endif
  361. {
  362. #include "fports.x"
  363. }
  364.  
  365.